# 
# Copyright 2007 Hector Francisco Hernandez
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#

# $ Id $

package require Tk

set ::SCREENW 640
set ::SCREENH 480

array set ::colores {
    . black
    + SandyBrown
    @ black
    # yellow
    $ "green yellow"}

set ::img1 {
    {. . . . . . . . + + + + . . . . . . . .}
    {. . . . . . . + + + + + + . . . . . . .}
    {. . . . . . . + @ @ @ @ + . . . . . . .}
    {. . . . . . . + + + + + + . . . . . . .}
    {. . . . . . . . + + + + . . . . . . . .}
    {. . . . + + + + + + + + + + + + . . . .}
    {. . . + + + + + + @ @ + + + + + + . . .}
    {. . + + + + + + @ + + @ + + + + + + . .}
    {. + + + + + + @ + + + + @ + + + + + + .}
    {. + + + . . @ + + + + + + @ . . + + + .}
    {+ + + . . . + + + + + + + + . . . + + +}
    {+ + + . . . + + + + + + + + . . . + + +}
    {+ + + . . . + + + + + + + + . . . + + +}
    {+ + + . . . + + + + + + + + . . . + + +}
    {. . . . . + + + + + + + + + + . . . . .}
    {. . . . + + + + + . . + + + + + . . . .}
    {. . . . + + + + . . . . + + + + . . . .}
    {. . . + + + + + . . . . + + + + + . . .}
    {. . . + + + + . . . . . . + + + + . . .}
    {. . . + + + . . . . . . . . + + + . . .}}

set ::img2 {
    {+ + + . . . . . + + + + . . . . . . . .}
    {+ + + . . . . + + + + + + . . . . . . .}
    {+ + + . . . . + @ @ @ @ + . . . . . . .}
    {+ + + . . . . + + + + + + . . . . . . .}
    {. + + + . . . . + + + + . . . . . . . .}
    {. + + + + + + + + + + + + + + + . . . .}
    {. . + + + + + + + @ @ + + + + + + . . .}
    {. . . + + + + + @ + + @ + + + + + + . .}
    {. . . . + + + @ + + + + @ + + + + + + .}
    {. . . . . . @ + + + + + + @ . . + + + .}
    {. . . . . . + + + + + + + + . . . + + +}
    {. . . . . . + + + + + + + + . . . + + +}
    {. . . . . . + + + + + + + + . . . + + +}
    {. . . . . . + + + + + + + + . . . + + +}
    {. . . . . + + + + + + + + + + . . . . .}
    {. . . . + + + + + . . + + + + + . . . .}
    {. . . . + + + + . . . . + + + + . . . .}
    {. . . + + + + + . . . . + + + + + . . .}
    {. . . + + + + . . . . . . + + + + . . .}
    {. . . + + + . . . . . . . . + + + . . .}}

set ::img3 {
    {. . . . . . . . + + + + . . . . . + + +}
    {. . . . . . . + + + + + + . . . . + + +}
    {. . . . . . . + @ @ @ @ + . . . . + + +}
    {. . . . . . . + + + + + + . . . . + + +}
    {. . . . . . . . + + + + . . . . + + + .}
    {. . . . + + + + + + + + + + + + + + + .}
    {. . . + + + + + + @ @ + + + + + + + . .}
    {. . + + + + + + @ + + @ + + + + + . . .}
    {. + + + + + + @ + + + + @ + + + . . . .}
    {. + + + . . @ + + + + + + @ . . . . . .}
    {+ + + . . . + + + + + + + + . . . . . .}
    {+ + + . . . + + + + + + + + . . . . . .}
    {+ + + . . . + + + + + + + + . . . . . .}
    {+ + + . . . + + + + + + + + . . . . . .}
    {. . . . . + + + + + + + + + + . . . . .}
    {. . . . + + + + + . . + + + + + . . . .}
    {. . . . + + + + . . . . + + + + . . . .}
    {. . . + + + + + . . . . + + + + + . . .}
    {. . . + + + + . . . . . . + + + + . . .}
    {. . . + + + . . . . . . . . + + + . . .}}

set ::img4 {
    {. # # #}
    {# # . .}
    {# . . .}
    {. . . .}}

set ::img5 {
    {. # # .}
    {. . # #}
    {. . . #}
    {. . . #}}

set ::img6 {
    {. . . .}
    {. . . #}
    {. . # #}
    {# # # .}}

set ::img7 {
    {# . . .}
    {# . . .}
    {# # . .}
    {. # # .}}



proc main {} {
  font create f -family courier -size \
      [expr {$::tcl_platform(platform) == "windows" ? 16 : 20}] -weight bold

  wm protocol . WM_DELETE_WINDOW {exit 0}
  canvas .canvas -width $::SCREENW -height $::SCREENH -bg black
  pack .canvas
  raise .

  set ::buildings [image create photo -width 640 -height 480]
  set ::gorimg(0) [ascii2photo $::img1]
  set ::gorimg(1) [ascii2photo $::img2]
  set ::gorimg(2) [ascii2photo $::img3]
  set ::banimg(0) [ascii2photo $::img4]
  set ::banimg(1) [ascii2photo $::img5]
  set ::banimg(2) [ascii2photo $::img6]
  set ::banimg(3) [ascii2photo $::img7]

  .canvas create image 320 240 -image $::buildings

  set winner [jugar]

  .canvas create text [expr {$::SCREENW / 2}] [expr {$::SCREENH / 2}] \
      -fill orange -font f -justify center \
      -text "Player [expr {$winner == 1 ? "One" : "Two"}] Wins!\n\nPress Return to Continue"

}



proc genesc {} {
  set ::ledif {}
  set x1 0
  set gor1edif [expr {int (3 * rand ())}]
  set gor2edif [expr {7 + int (3 * rand ())}]

  for {set i 0} {$i < 10} {incr i} {
    set x [expr {$x1 + 2}]
    set y [expr {round ($::SCREENH - [expr {$::SCREENH / 2}] * rand ())}]
    set x1 [expr {round ($x + ($::SCREENW - $x) / (10 - $i) * \
        (9 != $i ? (0.8 + 0.4 * rand ()) : 1))}]
    set y1 $::SCREENH
    set gorx 0

    if {$gor1edif == $i} {
      set gorx [expr {10 + ($x1 - $x - 20) * rand ()}]
      .canvas create image [expr {$x + $gorx}] [expr {$y - 11}] \
          -image $::gorimg(0) -tag gorila1

      set ::gor1x [expr {$x + $gorx}]
      set ::gor1y $y
    } elseif {$gor2edif == $i} {
      set gorx [expr {10 + ($x1 - $x - 20) * rand ()}]
      .canvas create image [expr {$x + $gorx}] [expr {$y - 11}] \
          -image $::gorimg(0) -tag gorila2

      set ::gor2x [expr {$x + $gorx}]
      set ::gor2y $y
    }

    lappend ::ledif $x $y $x1 $y1 $gorx

    bmpdrawrect $::buildings $x $y $x1 $y1 \
        [expr {rand () < 0.33 ? "cyan4" : (rand () < 0.5 ? "gray60" : "red4")}]
#    .canvas create rectangle $x $y $x1 $y1 -outline #000060 -fill \
#    .canvas create image $x $y -image [image create photo
#-background \
        [expr {rand () < 0.33 ? "cyan4" : (rand () < 0.5 ? "gray60" : "red4")}]

    # draw the windows
      set winx [expr {$x + 10}]
      set limx [expr {$x1 - 2}]

      while {$winx < $limx} {
        set winy [expr {$y + 10}]

        while {$winy < $::SCREENH} {
          set color [expr {rand () < 0.33 ? "gray30" : "yellow"}]

          bmpdrawrect $::buildings [expr {$winx - 3}] [expr {$winy - 5}] \
              $winx $winy $color

          set winy [expr {$winy + 15}]
        }

        set winx [expr {$winx + 10}]
      }
  }
}



proc jugar {} {
  genesc
  set ::lexplo {}

  while {1} {

    set ang [getang 10 10 nw]
    if {$ang == -1} {
      return 0
    }

    set vel [getvel 10 10 nw $ang]
    if {$vel == -1} {
      return 0
    }

    set ret [caltiro [expr {$::gor1x - 10}] [expr {$::gor1y - 20}] $ang $vel \
        tiro]

    .canvas itemconfigure gorila1 -image $::gorimg(1)
if {0} {
    .canvas delete -tag gorila1
    .canvas create image $::gor1x [expr {$::gor1y - 10}] -tag gorila1 \
        -image $::gorimg(1)
    update
    after 100 {
      .canvas delete -tag gorila1
      .canvas create image $::gor1x [expr {$::gor1y - 10}] -tag gorila1 \
          -image $::gorimg(0)
    }
}

    dibtiro $tiro
    if {$ret == 1} {
      set x [lindex $tiro end-1]
      set y [lindex $tiro end]
      lappend ::lexplo $x $y
      .canvas create oval [expr {$x - 5}] [expr {$y - 5}] [expr {$x + 5}] \
          [expr {$y + 5}] -fill #2c2b77 -outline #2c2b77
    } elseif {$ret == 2} {
      .canvas create oval [expr {$::gor1x - 15}] [expr {$::gor1y - 25}] \
          [expr {$::gor1x + 15}] [expr {$::gor1y + 5}] -fill #000060 \
          -outline #000060

      return 2
    } elseif {$ret == 3} {
      .canvas create oval [expr {$::gor2x - 15}] [expr {$::gor2y - 25}] \
          [expr {$::gor2x + 15}] [expr {$::gor2y + 5}] -fill #000060 \
          -outline #000060

      return 1
    }

    set ang [getang $::SCREENW 10 ne]
    if {$ang == -1} {
      return 0
    }

    set vel [getvel $::SCREENW 10 ne $ang]
    if {$vel == -1} {
      return 0
    }

    set ret [caltiro [expr {$::gor2x + 10}] [expr {$::gor2y - 20}] \
        [expr {180 - $ang}] $vel tiro]

    .canvas delete -tag gorila2
    .canvas create image $::gor2x [expr {$::gor2y - 10}] -tag gorila2 \
        -image $::gorimg(2)
    update
    after 100 {
      .canvas delete -tag gorila2
      .canvas create image $::gor2x [expr {$::gor2y - 10}] -tag gorila2 \
          -image $::gorimg(0)
    }

    dibtiro $tiro

    if {$ret == 1} {
      set x [lindex $tiro end-1]
      set y [lindex $tiro end]
      lappend ::lexplo $x $y
      .canvas create oval [expr {$x - 5}] [expr {$y - 5}] [expr {$x + 5}] \
          [expr {$y + 5}] -fill #2c2b77 -outline #2c2b77
    } elseif {$ret == 2} {
      .canvas create oval [expr {$::gor1x - 15}] [expr {$::gor1y - 25}] \
          [expr {$::gor1x + 15}] [expr {$::gor1y + 5}] -fill #000060 \
          -outline #000060

      return 2
    } elseif {$ret == 3} {
      .canvas create oval [expr {$::gor2x - 15}] [expr {$::gor2y - 25}] \
          [expr {$::gor2x + 15}] [expr {$::gor2y + 5}] -fill #000060 \
          -outline #000060

      return 1
    }

  }

}



proc getang {x y anchor} {
  set ang ""
  .canvas create text $x $y -fill orange -font f -anchor $anchor -tag ang \
      -text "Angle?       "

  while {1} {
    set opt [getkey]

    switch $opt {
      Escape {
        while {1} {
          .canvas create text 260 130 -fill orange -font f -tag escmsg -text \
              "Go back to the menu?\n\n(y/n)" -justify center
          set opt [getkey]
          .canvas delete escmsg

          switch $opt {
            Y -
            y {
              .canvas delete ang
              return -1
            }
            N -
            n {
              break
            }
          }
        }
      }
      0 -
      1 -
      2 -
      3 -
      4 -
      5 -
      6 -
      7 -
      8 -
      9 {
        if {[string length $ang] < 3} {
          set ang "$ang$opt"
          .canvas itemconfigure ang -text [format "Angle? %-3s   " $ang]
        }
      }
      Delete -
      BackSpace {
        set strlen [string length $ang]
        set ang [string range $ang 0 [expr {$strlen - 2}]]
        .canvas itemconfigure ang -text [format "Angle? %-3s   " $ang]
      }
      Return {
        .canvas delete ang
        return [expr {$ang == "" ? 0 : $ang}]
      }
    }
  }
}



proc getvel {x y anchor ang} {
  set vel ""
  .canvas create text $x $y -fill orange -font f -anchor $anchor -tag vel \
      -text [format "Angle: %-3s   \nVelocity?" $ang]

  while {1} {
    set opt [getkey]

    switch $opt {
      Escape {
        while {1} {
          .canvas create text 260 130 -fill orange -font f -tag escmsg -text \
              "Go back to the menu?\n\n(y/n)" -justify center
          set opt [getkey]
          .canvas delete escmsg

          switch $opt {
            Y -
            y {
              .canvas delete vel
              return -1
            }
            N -
            n {
              break
            }
          }
        }
      }
      0 -
      1 -
      2 -
      3 -
      4 -
      5 -
      6 -
      7 -
      8 -
      9 {
        if {[string length $vel] < 3} {
          set vel "$vel$opt"
          .canvas itemconfigure vel -text \
              [format "Angle: %-3s   \nVelocity? %-3s" $ang $vel]
        }
      }
      Delete -
      BackSpace {
        set strlen [string length $vel]
        set vel [string range $vel 0 [expr {$strlen - 2}]]
        .canvas itemconfigure vel -text \
            [format "Angle: %-3s   \nVelocity? %-3s" $ang $vel]
      }
      Return {
        .canvas delete vel
        return [expr {$vel == "" ? 0 : $vel}]
      }
    }
  }
}



proc getkey {} {
  set keyscript [bind . <Key>]

  bind . <Key> {set ::key %K}
  tkwait variable ::key
  bind . <Key> $keyscript

  return $::key
}



proc ascii2photo {ascii} {
  set ascii1 {}

  foreach fila $ascii {
    set fila1 {}

    foreach columna $fila {
      lappend fila1 $::colores($columna)
    }

    lappend ascii1 $fila1
  }

  set photo [image create photo]
  $photo put $ascii1

  return $photo
}



proc dibtiro {tray} {
  set n 0

  foreach {x y} $tray {
    if {$n % 5 == 0} {
      .canvas delete banana
      .canvas create image $x $y -image $::banimg([expr {$n / 10}]) -tag banana
      update
      after 50
    }

    set n [expr {($n + 1) % 30}]
  }

  .canvas delete banana
}



proc caltiro {x y ang vel vartiro} {
  upvar $vartiro tiro

  set velx [expr {$vel * cos (3.1416 * $ang / 180) / 100}]
  set vely [expr {- $vel * sin (3.1416 * $ang / 180) / 100}]

  set tiro [list $x $y]

  while {$x > 0 && $x < 640 && $y < 480} {
    set x [expr {$x + $velx}]
    set y [expr {$y + $vely}]
    set vely [expr {$vely + 0.02}]

    lappend tiro $x $y

    if {hypot ($x - $::gor1x, $y - $::gor1y + 10) < 10} {
      return 2
    }

    if {hypot ($x - $::gor2x, $y - $::gor2y + 10) < 10} {
      return 3
    }

    foreach {edx edy edx1 edy1 gorx} $::ledif {
      if {$x < $edx || $x > $edx1 || $y < $edy} {
        continue
      }

      set col 1

      foreach {exx exy} $::lexplo {
        if {hypot ($x - $exx, $y - $exy) < 5} {
          set col 0
          break
        }
      }

      if {$col == 0} {
        break
      }

      return 1
    }
  }

  return 0
}



proc gorshoot {n} {
        switch $n \
        1 {
                .canvas itemconfigure gor1bd -start -120 -extent -70
                .canvas move gor1bd 0 -18
                after 100 {
                        .canvas itemconfigure gor1bd -start 120 -extent 70
                        .canvas move gor1bd 0 18
                }
        } 2 {
                .canvas itemconfigure gor2bi -start -60 -extent 70
                .canvas move gor2bi 0 -18
                after 100 {
                        .canvas itemconfigure gor2bi -start 60 -extent -70
                        .canvas move gor2bi 0 18
                }
        }
}



proc bmpdrawrect {bmp x y x1 y1 col} {
  $bmp put $col -to $x $y [expr {$x1 + 1}] [expr {$y1 + 1}]
}



exit [main]

################################################################################
# basura
################################################################################

proc gorexpl {n x y} {
  .canvas create oval [expr $x - 8] [expr $y - 23] [expr $x + 8] \
      [expr $y - 5] -fill red -outline red -tag expl
  after 100 {
    set coords [.canvas coords expl]
    set x [expr ([lindex $coords 0] + [lindex $coords 2]) / 2]
    set y [expr ([lindex $coords 1] + [lindex $coords 3]) / 2]
    .canvas scale expl $x $y 2 2
  }
  after 200 {.canvas itemconfigure expl -fill blue4 -outline blue4}
}

proc dibedif {edif} {
        array set edifcolr {
                0   cyan4
                1   gray60
                2   red4
        }

        set x [lindex $edif 0]
        set y [lindex $edif 1]
        set x1 [lindex $edif 2]
        set y1 [lindex $edif 3]
        set ncolor [lindex $edif 4]
        .canvas create rectangle $x $y $x1 $y1 -fill \
                        $edifcolr($ncolor) -outline blue4

    array set windows_colors {
        0   yellow
        1   yellow
        2   gray30
    }

    # dibuja las ventanas
	expr srand ([lindex $edif 5])
        set win_x1 [expr $x + 10]
        set limite_x1 [expr $x1 - 2]
        while {$limite_x1 > $win_x1} {
                set win_y1 [expr $y + 10]
                while {385 > $win_y1} {
                    set ncolor [expr int (3 * rand ())]
                    .canvas create rectangle [expr $win_x1 - 3] \
                            [expr $win_y1 - 5] $win_x1 $win_y1 \
                            -fill $windows_colors($ncolor) \
                            -outline $windows_colors($ncolor)
                    set win_y1 [expr $win_y1 + 15]
                }
                
                set win_x1 [expr $win_x1 + 10]
        }
}

proc findcol {x y ledifs lexpls} {
        foreach edif $ledifs {
                if {[lindex $edif 0] > $x || [lindex $edif 1] > $y ||
                                [lindex $edif 2] < $x ||
                                [lindex $edif 3] < $y} continue

            # en caso de tocar el edificio verifica que no este en el hueco
            # de una explosion
                foreach expl $lexpls {
                        set distx [expr $x - [lindex $expl 0]]
                        set disty [expr $y - [lindex $expl 1]]
                        if {10 > [expr sqrt \
                                ($distx * $distx + $disty * $disty)]} {return 0}
                }

                return 1
        }

        return 0
}

proc banshoot {x y ang vel dir ledifs lexpls vlpos} {
        upvar $vlpos lpos

    # descompone la velocidad de la banana
        set velx [expr {("right" == $dir ? 1 : -1) *
                ($vel / 100.0 * cos (3.1416 / 180 * $ang))}]
        set vely [expr $vel / 100.0 * sin (3.1416 / 180 * $ang)]

        set gor1x [expr $gor1x - 15]
        set gor1y [expr $gor1y - 15]
        set gor1x1 [expr $gor1x + 30]
        set gor1y1 [expr $gor1y + 30]

        set gor2x [expr $gor2x - 15]
        set gor2y [expr $gor2y - 15]
        set gor2x1 [expr $gor2x + 30]
        set gor2y1 [expr $gor2y + 30]

        set lpos [list [list $x $y]]
        while 1 {
                if {0 > $x || 520 < $x || 390 < $y} {return 0}

                #if {$gor1x < $x && $gor1x1 > $x && $gor1y < $y &&
                #                $gor1y1 > $y} {return 2}
                
                #if {$gor2x < $x && $gor2x1 > $x && $gor2y < $y &&
                #                $gor2y1 > $y} {return 3}

            # busca choques con los edificios
                if [findcol $x $y $ledifs $lexpls] {return 1}

            # mueve la banana
                set x [expr $x + $velx]
                set y [expr $y - $vely]

                lappend lpos [list $x $y]

            # efecto de la gravedad
                set vely [expr $vely - 0.0098]
        }
}

proc banshoot {lpos col} {
    if {{} == $lpos} {
        switch $col \
        1 {
                set pos [lindex $lpos end]
                set x [lindex $pos 0]
                set y [lindex $pos 1]
                lappend ::lexpls [list $x $y]
                .canvas create oval [expr $x - 10] [expr $y - 10] \
                                [expr $x + 10] [expr $y + 10] -fill blue4 \
                                -outline blue4
        } 2 {
                .canvas delete gorila1
        } 3 {
                .canvas delete gorila2
        }

        return
    }
    set pos [lindex $lpos 0]
    banmove [lindex $pos 0] [lindex $pos 1]
    after 100 [list banshoot [lrange $lpos 1 end]]
}

proc lanzar_banana {x y ang vel dir} {
    # crea la banana
        bancreat

        #set col [calctray $x $y $ang $vel $dir $::ledifs $::lexpls lpos \
                        $::gor1x $::gor1y $::gor2x $::gor2y]

  calctray $x $y $ang $vel $dir

        set lpos1 {}
        for {set i 0} {[llength $lpos] > $i} {incr i 10} \
                        {lappend lpos1 [lindex $lpos $i]}

        banshoot $lpos1
        return

}

proc reqinput {} {
        if ![dlgtiro ang vel] return
        if {![string is integer $ang] || 0 > $ang || 999 < $ang} return
        if {![string is integer $vel] || 0 > $vel || 999 < $vel} return
        if {0 == [expr $::nturno % 2]} {
                gorshoot 1
                lanzar_banana $::gor1x [expr $::gor1y - 20] $ang $vel right
        } else {
                gorshoot 2
                lanzar_banana $::gor2x [expr $::gor2y - 20] $ang $vel left
        }
        incr ::nturno
}

proc iniciar {} {
        #gensc ::ledifs ::gor1x ::gor1y ::gor2x ::gor2y
  #gensc
        set ::lexpls {}
        set ::nturno 0

  canvas .canvas -background blue4 -width 520 -height 390
  entry .info -state readonly -textvariable ::info
  pack .canvas
  pack .info -side bottom -fill x
  set ::info "Esto es solo un prototipo."

	return
  wm withdraw .
  update
  centrew .

# dibuja los edificios
  foreach edif $::ledif {dibedif $edif}

  gordraw 1 $::gor1x $::gor1y
  gordraw 2 $::gor2x $::gor2y

# dibuja la luna
  .canvas create oval 240 20 280 60 -fill gray100 -outline gray100

        #after 3000 {gorexpl 1 $::gor1x $::gor1y}

        #set ::info "Es el turno del jugador 1. Presione \"Return\" la lanzar la"
  bind . <Return> dotray
  wm deiconify .
}

if 0 {
canvas .canvas -background blue4 -width 520 -height 390
entry .info -state readonly -textvariable ::info
pack .canvas
pack .info -side bottom -fill x
set ::info "Esto es solo un prototipo."

#exec gorilla-gensc esta
set fd [open esta]
while {"" != [set edif [gets $fd]]} {dibedif $edif}
close $fd

#update
#.canvas postscript -file prueba.ps
}

#iniciar
#.canvas create rectangle 90 90 110 110 -fill yellow -outline yellow
#dibgor 1 100 110
#dibgor 2 200 110

proc dosc {} {
  gensc
# dibuja los edificios
  foreach edif $::ledif {dibedif $edif}

  gordraw 1 $::gor1x $::gor1y
  gordraw 2 $::gor2x $::gor2y

# dibuja la luna
  .canvas create oval 240 20 280 60 -fill gray100 -outline gray100
}

